Pascal Super Library/Pascal Super Library (CW International)(1997).bin/PGM_TOOL/RLINE_OP/RLTEST.PAS

Pascal/Delphi Source File | 1989-10-09 | 6KB | 245 lines

PROGRAM RLtest;
  { Test program for the RLINE unit.

  Does a speed comparison between FReadLn and ReadLn,
       a file position/seek test,
       and types a file to the screen.

  Test with different files and buffer sizes (CONST BS, below).
  }

USES
  DOS, CRT, RLINE;

  { Global constants and variables.}
CONST
  BS      = 8192;            { Disk Buffer size. }

TYPE
  RFtester = Object(RFextended)
    PROCEDURE CheckRFerror; virtual;
  END;

  PROCEDURE RFtester.CheckRFerror;
    { Displays some of the common errors, and waits for a keypress. }
  VAR
    S       : STRING[80];
  BEGIN
    IF RFerror = 0 then exit;
    WriteLn(RFerrorString);
    IF (RFerror <> $FFFF)
    THEN Halt(1);
  END;

VAR
  TBuf    : ARRAY[1..BS] OF Char;

PROCEDURE PressAnyKey;
BEGIN
  Writeln('Press any key.');
  While ReadKey = #0 Do ;
END;

  { Timing routine.  Derived from Neil Rubenking's TIMER.PAS in LIB 4. }
TYPE
  OnOrOff = (On, Off);

VAR
  start, time : Real;

  PROCEDURE timer(O : OnOrOff);
  VAR
    hour, min, sec, hun : Word;
  BEGIN
    GetTime(hour, min, sec, hun);
    time := hour*3600+min*60+sec+hun/100;
    CASE O OF
      On : start := time;
      Off : BEGIN
              time := time-start;
              Write('Time: ', time:6:2, ' ');
            END;
    END;
  END;

  (************************************************************************)

  PROCEDURE PrepForTimingTest(Fn : STRING);
    { Opens and read Fn, before doing the FReadLn/ReadLn timing tests.
    Otherwise, the order the two tests are performed produces different
    results ( probably because the disk heads start in different positions,
    and maybe second test benefits from using previously filled DOS buffers. }
  VAR
    i  : Integer;
    j  : LongInt;
    RF : RFtester;
    S  : String;
  BEGIN
    WriteLn('Reading file to prepare for timing tests..');
    RF.Init(Fn, BS, TBuf);
    RF.CheckRFerror;
    WHILE RF.RFerror = 0 DO RF.FReadLn(S);
    RF.Done;
  END;

  PROCEDURE ReadLnTest(Fn : STRING);
    { Time comparison between FReadLn and ReadLn }
  VAR
    NLines  : LongInt;
    Ch : char;
    RF : RFtester;
    S  : String;
    F  : Text;
    i  : Integer;
  BEGIN
    {Test FReadLn}
    IF Not RF.Init(Fn, BS, TBuf) THEN BEGIN
      Writeln('Not enough memory.');
      Halt(1);
    END;
    RF.CheckRFerror;

    Writeln('FReadLn timing test: Reading strings from ', Fn, '.. ');
    NLines := 0;
    timer(On);

    RF.FReadLn(S);
    While RF.RFerror = 0 DO BEGIN
      Inc(NLines);
      RF.FReadLn(S);
    END;
    RF.CheckRFerror;
    timer(Off); WriteLn;
    Writeln(NLines, ' lines were read.');

    WriteLn;

    {Test TP ReadLn}
    Assign(f, Fn);
    Reset(f);
    RF.RFerror := IoResult;
    RF.CheckRFerror;

    WriteLn('ReadLn timing test: Reading strings from ', Fn, '... ');
    SetTextBuf(f, TBuf);
    NLines := 0;
    timer(On);
    REPEAT
      ReadLn(f, S);
      i := IoResult;
      IF i = 0
      THEN Inc(NLines);
    UNTIL EOF(F) OR (i <> 0);
    timer(Off); WriteLn;
    WriteLn(NLines, ' lines were read.   IoResult = ',i);

    writeln;
    {Test FRead}
    RF.Reset;
    RF.CheckRFerror;

    WriteLn('FRead timing test: Reading chars from ', Fn, '.. ');
    NLines := 0;
    timer(On);
    RF.FRead(ch);
    While RF.RFerror = 0 DO BEGIN
      Inc(NLines);
      RF.FRead(ch);
    END;
    timer(Off); WriteLn;
    Write(NLines, ' chars were read.');
    RF.CheckRFerror;
    RF.Done;
  END;


  PROCEDURE TypeFile(Fn : STRING);
    { TYPE a file to the screen.  A useless procedure except that it
    demonstrates using a buffer allocated on the heap to be used by RLINE. }
  VAR
    RF   : RFtester;         { Declare RFrec variable. }
    TBuf : Pointer;
    S    : String;
  BEGIN
    ClrScr;
    GetMem(TBuf, BS);        { First, allocate memory for the buffer. }

    { Be certain to insert the ^ in TBuf^ when opening the file. }
    RF.Init(Fn, BS, TBuf^); { try to open the file. }
    RF.CheckRFerror;

    RF.FReadLn(S);
    While RF.RFerror = 0 DO BEGIN
      IF keypressed AND (readkey = ^S) { if user pressed ^S, then pause }
      THEN IF readkey <> #0 THEN ; { the display by forcing a keypress. }

      WriteLn(S);       { if no error, then display the line. }
      RF.FReadLn(S);    { Attempt to read the next line from the file. }
    END;
    RF.CheckRFerror;
    RF.Done;
    FreeMem(TBuf, BS);       { Deallocate memory for the buffer. }
  END;


  PROCEDURE PositioningTest(Fn : STRING);
  VAR
    NLines, lno : LongInt;
    ch      : Char;
    RF : RFtester;
    S : String;
  BEGIN
    ClrScr;
    WriteLn('     Pos    Line     Pos    Line     Pos    Line     Pos    Line     Pos    Line');

    RF.Init(Fn, BS, TBuf);   { Open Fn }
    RF.CheckRFerror;

    window(1, 2, 80, 25);
    NLines := 0;
    Write(RF.FFilepos:8, NLines:8);
    RF.FReadLn(S);
    While RF.RFerror = 0 Do BEGIN
      Inc(NLines);
      Write(RF.FFilepos:8, NLines:8);
      RF.FReadLn(S);
    END;

    WriteLn(^j^j^j^j);
    window(1, 21, 80, 25);

    REPEAT
      Write('(10000 to quit) Seek to: '); ReadLn(lno);
      RF.fseek(lno);
      IF RF.RFerror = 0 THEN BEGIN
        RF.FRead(ch);   RF.CheckRFerror;
        WriteLn('Char is: #', Ord(ch));
        RF.fseek(lno); RF.CheckRFerror;
        RF.FReadLn(S); RF.CheckRFerror;
        WriteLn(S);
      END ELSE Writeln(RF.RFerrorString);
    UNTIL lno = 10000;
    RF.Done;
    window(1, 1, 80, 25);
  END;


BEGIN
  WriteLn;
  IF ParamCount = 0 THEN BEGIN
    Write('You must specify a Filename on command line.');
    Halt(1);
  END;

  PrepForTimingTest(ParamStr(1));

  ReadLnTest(ParamStr(1));

  Pressanykey;

  IF ParamCount > 1
  THEN PositioningTest(ParamStr(2))
  ELSE PositioningTest(ParamStr(1));

  TypeFile(ParamStr(1));
END.